home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / ispell.tcl.z / ispell.tcl
Text File  |  2002-07-08  |  30KB  |  918 lines
  1. #################################################################################
  2. # TCL Interactive Spell Checker Version 1.01 
  3. # Developed for use in EXMH by John McLaughlin (johnmcl@sr.hp.com) 6/7/97
  4. # 
  5. # This new spell checking code for EXMH was developed out of
  6. # frustration with the current spell checking EXMH code
  7. # mostly I could not get it to work the way I wanted it to.
  8. # Because I couldn't get the spell checker to work as well
  9. # as I would like, I found myself spending inordinate amounts
  10. # of time when writing e-mail, constantly fretting over
  11. # the spelling.  This little piece of code is the result
  12. # and seems to work pretty well in my environment.  I have
  13. # tested this under both linux (redhat 4.0) HPUX 9.05
  14. # 
  15. # This software operates in one of two different
  16. # modes, it can either spell check as you type, marking words
  17. # in a variety of ways (underline, bold, italic, etc) that are
  18. # not spelled correctly.  Also it can put a button in the sedit
  19. # window to allow in place spell checking. (The button option
  20. # requires changes to your .exmh-defaults file)
  21. #
  22. # This code depends on the excellent 'ispell' program and most
  23. # of the variables & procedure's get their name from it.
  24. # This code was developed under ispell v3.1.20
  25. #
  26. #######################################################################
  27. #             INSTALLATION
  28. # to Use: 3 easy steps (Note: EXMH should not be running when you do this)
  29. #
  30. # Note 2: This may be incorporated into a 'core' EXMH release in 
  31. # the future so below may not be required.....
  32. #
  33. # 1) add to the file ~/.tk/exmh/user.tcl in the function 'User_Init'
  34. #    a call to ispell_Preferences.  If you don't have a user.tcl
  35. #    get one, Usually it can be found in '/usr/local/exmh-<version>'
  36. #    where <version> is the version of exmh you are running
  37. # 
  38. #    if you are really desperate for a user.tcl the following
  39. #    should work (just make a file called user.tcl with the
  40. #    following line.....
  41. #    proc User_Init {} { ispell_Preferences }
  42. #
  43. # 
  44. # 2) add the following to your .exmh-defaults at the TOP of the file
  45. # 
  46. # *Sedit.Menubar.ubuttonlist: ispell
  47. # *Sedit.Menubar.ispell.text: Ispell        
  48. # *Sedit.Menubar.ispell.command: Ispell_CheckEntireWindow $t
  49. #
  50. # 3) in your ~/.tk/exmh directory type 'wish' then type 
  51. #         auto_mkindex . *.tcl
  52. #    then type 'exit'
  53. # 
  54. #  
  55. # That should be it!  There should be a preferences menu for 'I-Spell' now to allow
  56. # control of various parts of the ispell package... Also the 'Sedit' window should
  57. # have a 'ispell' button to check the entire document...
  58. # if a word is marked misspelled right click on it to add to dictionary or
  59. # select an alternate version
  60. #
  61. ############## Trouble Shooting ######################
  62. #
  63. # Did you make sure that....
  64. # Ispell was turned on? (from preferences/I-spell  menu)
  65. # A 'Miss-Spelled word style' is selected? (from preferences/I-spell)
  66. # the User Library directory is ~/.tk/exmh (preferences/Hacking Support)
  67. # the changes above were made with EXMH NOT running?
  68. #
  69. # You are using the correct version of ispell?  it works against ispell
  70. # version 3.0 & 3.1, version 4.0 (which seems to be a sort of 'non product'
  71. # is reported NOT to work.  most un*x users seem to have 3.1 installed..
  72. #
  73. ############## Performance ##########################
  74. #
  75. # This spell checker seems to operate without any 
  76. # obvious performance drag when typing in sedit
  77. # with enough ram, most modern workstations should 
  78. # be able to use this without any obvious performance hit
  79. # I find running it under Linux with a 40mb P90
  80. # quite comfortable
  81. # as a few benchmarks, this software can spell check
  82. # a 2700 word letter in 12 seconds on a P90 running
  83. # linux (redhat 4.0) with 40mb of ram.  other 
  84. # timing results indicate a user can expect 
  85. # a 1.3ms to 3.0ms additional delay for
  86. # correctly spelled words, and up to 30ms
  87. # for words not spelled correctly.  As always
  88. # ram helps, ram starved machines will 
  89. # not fair as well
  90. ######################################################
  91. #
  92. # Enjoy, if you find it useful or have any comments
  93. # please let me know (johnmcl@sr.hp.com) also if you 
  94. # make any improvements please send them to me
  95. #
  96. # John McLaughlin, HP Santa Rosa, January 1997 (johnmcl@sr.hp.com)
  97. ######################################################
  98.  
  99. #########################################################
  100. # ispell_init is called to start the entire process off
  101. #########################################################
  102. proc Ispell_Init { } { 
  103.     global ispellVars
  104.  
  105.     if {! [ info exists ispellVars(currentLanguage) ] } {
  106.     set ispellVars(currentLanguage) ""
  107.     }
  108.  
  109.     if { $ispellVars(currentLanguage) == $ispellVars(language) } return ; 
  110.  
  111.     set ispellVars(currentLanguage) $ispellVars(language)  ; # mark current language
  112.  
  113.  
  114.     # These things are now specified by the 'Preferences' menu
  115.     #    a good choice f0or the spell command is "ispell -a"
  116.     #   
  117.     set ispellVars(last_word) "dummy" 
  118.     # this variable are the alternate spellings of the misspelled word...
  119.     set ispellVars(choices) "" 
  120.  
  121.     # how to view, see the text.n man page for other ideas
  122.     # options include -background <color> -foreground <color> 
  123.     # -font <font> etc..
  124.     #    set ispellVars(viewStyle) "-underline t"
  125.  
  126.     if { [ info exists ispellVars(spell_buffer) ] } {
  127.     if { [catch {
  128.         close $ispellVars(spell_buffer)
  129.     } reason] } {
  130.          Exmh_Debug Ispell Buffer Closed:$reason
  131.     }
  132.     }
  133.  
  134.     if {!$ispellVars(on)} {
  135.     set ispellVars(currentLanguage) "disabled"
  136.     }
  137.     if {$ispellVars(currentLanguage) == "disabled"} {
  138.     catch {unset ispellVars(spell_buffer) }
  139.     return ;
  140.     }
  141.  
  142.     if {[info exists ispellVars(command)]} {
  143.     set cmd $ispellVars(command)
  144.     } else {
  145.     set cmd $ispellVars(defaultCommand)
  146.     }
  147.     if [catch {open "|$cmd" r+} ispellVars(spell_buffer)] {
  148.     set ispellVars(on) 0    ;# triggers trace
  149.     return
  150.     }
  151.  
  152.     # Poke the process because:
  153.     # 4.0 doesn't respond with a full line, so gets hangs
  154.     # 2.0 doesn't output a version number.
  155.     # We only like 3.*
  156.  
  157.     puts $ispellVars(spell_buffer) "?"
  158.     flush $ispellVars(spell_buffer)
  159.     gets $ispellVars(spell_buffer) line
  160.     set version {"unknown"}
  161.     if {([string compare $line *] == 0) ||
  162.     ([regexp {[Vv]ersion ([0-9])\.} $line x version] &&
  163.         $version != 3)} {
  164.     # Oh No!  Why are you not running version 3.X???
  165.     # specifically version 4.0 doesn't work!!!
  166.     Exmh_Status "Ignoring ispell version $version (3.* required)"
  167.     catch { close $ispellVars(spell_buffer) } reason
  168.     set ispellVars(on) 0
  169.     return
  170.     }
  171.     #
  172.     # Since this is the right version, we need to read the (blank) reply to
  173.     # the "?" we sent...
  174.     #
  175.     gets $ispellVars(spell_buffer) line
  176.  
  177.     IspellWriteSpellBuffer "!" ; # enter terse mode
  178. }
  179.  
  180. ######################
  181. # preferences
  182. ######################
  183.  
  184. proc Ispell_Preferences {} { 
  185.  
  186.     Preferences_Add "I-Spell" \
  187.         "This is a module to allow interactive spelling within a sedit window
  188. it has many fine features include suggested correction and the ability
  189. to add new words to a session or to your personnel dictionary.
  190. For words that are either not correct or not generated 
  191. by a combination of roots or compounds, the word is marked as not
  192. spelled correctly." { 
  193.  
  194.     { ispellVars(on) ispellOnOff ON {Turn Ispell On/Off} 
  195.     "This turns the ispell feature on/off.  Note that the feature
  196.     needs to be enabled BEFORE a message is brought up" } 
  197.  
  198.     { ispellVars(ReCheckAfterAdd) ispellRecheckAfterAdd ON {Re-Verify after Adds?} 
  199.     "Check this box if you want to re spell check words 
  200.     currently marked Miss Spelled after you add to the dictionary 
  201.     or session.  In general a good idea except if you work 
  202.     in extremely long documents a small delay may be noticed 
  203.     after you add words to your personal dictionary
  204.     Additionally the right mouse button can be used to
  205.     accept suggested words" }
  206.  
  207.     { ispellVars(textOnly) ispellTextOnly OFF {Spell Check 'Text' only?} 
  208.     "Check this box if you want to only perform spell checking 
  209. of the text marked as 'text', this should avoid spell checking 
  210. To:, CC: & X-Face: lines, it comes at a small time penalty, turn it off
  211. if you want to see a small improvement in response time
  212. Note that turning this option on will also not spell check 'attachements'
  213. unless they are marked as Content-Type: text/enriched or text/plain.
  214. if you find that spell checking STOPS working in a section of the document you
  215. may want to turn this off" }
  216.  
  217.     { ispellVars(defaultCommand) ispellCommand "ispell -a -S" {Default speller invocation}
  218.     "This is the program used to actually do the real work
  219. 'ispell -a' is probably a good choice.  if you want to 
  220. use an alternate dictionary, 'ispell -a -d <dictionary-file>' may be 
  221. appropriate. you may find that -S sorts the list of possible
  222. words better, see the ispell(1) man page for more details.
  223. (really, it's got a lot of details and you can really personalize
  224. how it works to fit best with your environment" } 
  225.     { ispellVars(otherCommands) ispellOthers " German  { ispell -a -d deutsch } \
  226.         French { ispell -a -d francais } English { ispell -a -d english } " { Other Invocations }
  227.     "Alternate Invocations of of the 'Ispell' programs, mostly intended for 
  228. our friends in Europe who have to work in a variety of languages, this entry should
  229. be in label/invocation pairs" } 
  230.  
  231.     
  232.     { ispellVars(popupBinding) ispellPopupBinding "ButtonPress-3" {Menu popup bound to:}
  233.     " This controls what the 'popup' window is bound to, some examples include:
  234. ButtonPress-3 
  235. ButtonPress-2
  236. ButtonPress-1
  237. Shift-3
  238. Control-3
  239. Meta-2
  240. Alt-1
  241. etc...
  242.  
  243. Note that the menu is unposted on any ButtonRelease" }
  244.  
  245.     { ispellVars(viewStyle) ispellStyle {CHOICE underline italic bold bgcolor fgcolor other } {Miss-spelled word style}
  246.     " this is how to display misspelled words
  247.     use the built in types or create your own
  248.     using 'other', for 'color' ones fill in the color 
  249.     examples using other include 
  250.     -underline t
  251.     -background red
  252.     -foreground Bisque
  253.     -font <font>
  254.     -fgstipple <bitmap>
  255.     -bgstipple <bitmap>
  256.  
  257.     Bitmap's can be many things, 'gray50' and 'gray25' are popular
  258.  
  259.     For example....
  260.  
  261.     -font *italic*
  262.     or   -font *bold*
  263.     or   -font *24*    (Big!)
  264.  
  265.     or   -font *italic*24* (big italics)
  266.  
  267.     -relief <relief> (see tk doc's for more info...)
  268.  
  269.     
  270.     Effects can also be combined as in 
  271.     
  272.     -underline t -foreground red
  273.     -bgstipple gray25 -color red
  274.  
  275.     
  276.     " } 
  277.     { ispellVars(viewStyle-Color) ispellStyleColor red {color:} 
  278.     "color for fgcolor and bgcolor" }
  279.     { ispellVars(viewStyle-Other) ispellStyleOther {-underline t -foreground red}  {other:}
  280.     "Style if 'other' is selected" }
  281.     }
  282.     if { [ info exists ispellVars(CheckButton) ] } {
  283.     if {$ispellVars(CheckButton) == 1} {
  284.  
  285.         option add *Sedit.Menubar.ubuttonlist {ispell}
  286.         
  287.         option add *Sedit.Menubar.ispell.text {Ispell}
  288.         
  289.         option add *Sedit.Menubar.ispell.command {Ispell_CheckEntireWindow $t}
  290.     }
  291.     }
  292.     global ispellVars
  293.     set ispellVars(language) default
  294.     trace variable ispellVars(on) w IspellOnOff    
  295. }
  296.  
  297. proc IspellOnOff {args} {
  298.     global ispellVars
  299.     catch {unset ispellVars(currentLanguage)}
  300.     Ispell_Init
  301. }
  302.  
  303.  
  304.  
  305. # a safe procedure to write to the ispell buffer
  306. # this procedure dumps the variable 'word' to the spell buffer
  307. # if the buffer has died, it will restart it
  308.  
  309. proc IspellWriteSpellBuffer { word } {
  310.     global ispellVars
  311.     
  312.     if {$ispellVars(currentLanguage) == "disabled"} { return * } ;
  313.  
  314.     puts $ispellVars(spell_buffer) $word
  315.     if { [ catch { flush $ispellVars(spell_buffer) } ] } {
  316.     Exmh_Debug "Ispell process terminated!!!!!, temp disabling"
  317.     set ispellVars(language) disabled
  318.     Ispell_Init
  319.     return "*" ; # return if we had to restart
  320.     }
  321. }
  322.  
  323. # This procedure kills the ispell buffer
  324. # 
  325. proc Ispell_Kill {} { 
  326.     global ispellVars
  327.     close $ispellVars(spell_buffer)
  328.     set ispellVars(on) 0
  329. }
  330.  
  331. ##########################################
  332. # this is the proc that does the 
  333. # actual spell checking, it will return a 
  334. # '*' if everything is cool, otherwise
  335. # it returns a list of possible miss-spelled
  336. # words.  See ispell(1) for more details
  337. proc IspellWords line { 
  338.     global ispellVars
  339.  
  340.     regsub -all { +} $line { } line        ;# compress out extra spaces
  341.     set count [llength [split $line { }]]    ;# Count space separated words
  342.     set result ""
  343.  
  344.     if { $ispellVars(currentLanguage) == "disabled" } { return "*" } ;
  345.  
  346.     # clear out the fileevent
  347.     if { [ catch {fileevent $ispellVars(spell_buffer) readable {} } ] } {
  348.     Ispell_Init
  349.     return "*"
  350.     }
  351.     # so the puts stuff doesn't freak out
  352.     # CRITCAL prepend a '^' to keep the buffer from freaking
  353.     puts $ispellVars(spell_buffer) "^$line"
  354.     # we have to put the ^ in front of the line so ispell works correctly
  355.     # see ispell(1) for more details
  356.     if { [ catch { flush $ispellVars(spell_buffer) } ] } {
  357.     Exmh_Debug "Ispell process terminated!!!!!, restarting"
  358.     Ispell_Init
  359.     return "*" ; # return if we had to restart
  360.     }
  361.  
  362.     # loop through list of words, usually there is just 1
  363.     for { set i 0 } { $i <= $count } {  incr i } { 
  364.     gets $ispellVars(spell_buffer) var
  365.     if {$var == {} } then {
  366.         lappend result "*";
  367.         break;
  368.     }
  369.     lappend result $var
  370.     }
  371.     # invoke a fileevent to help flush out the data so wer are always in sync
  372.     fileevent $ispellVars(spell_buffer) readable {
  373.     global ispellVars
  374.     gets $ispellVars(spell_buffer) dummy 
  375.     }
  376.     return $result
  377. }
  378.  
  379.  
  380. # this proc spell checks the word under the current cursor
  381. # marking it with a 'MissSpelled' tag if it is in fact incorrect
  382. # text is the text window
  383. # This version runs about 300us slower than the previous
  384. # version using tk's built in 'wordstart' and 'wordend'
  385. # (1.3ms vs 1.7ms)
  386.  
  387. proc IspellTextWindow { text } { 
  388.  
  389. #################
  390. # WARNING
  391. # CHANGES FOR SUPPORT OF EUROPEAN CHARACTERS!!
  392. ##########################
  393.     set start [ $text get "insert linestart" insert ]
  394.     
  395.     set end   [ $text get insert "insert lineend" ] 
  396.     
  397.     set e1 ""
  398.     set s1 ""
  399.     
  400.     regexp "\[^\t \]*" $end e1
  401.     set e1 [ string trim $e1 ] 
  402.     regexp "\[^\t \]+$" $start s1
  403.     
  404.     set startIndex "insert - [string length $s1] chars"
  405.     set stopIndex "insert + [string length $e1] chars "
  406.  
  407.     set word "[ string trim $s1$e1 "\"\{\}\[\] \t" ] "
  408.  
  409.     IspellMarkWord $text $startIndex $stopIndex $word 
  410. }
  411.  
  412. # this Proc is to spell check words that with 'inserts'
  413. # i.e. after 'space', 'tab' etc.... This version
  414. # runs at exactly the same speed as the tk built
  415. # in version (1.3ms) so I feel pretty comfortable
  416. # that this shouldn't effect speed too much
  417. # all test times were gotten via 'time' 
  418. # and thus may have some errors (especially 
  419. # with regexps, I think the system compiles
  420. # them).  In this version I can't use
  421. # tk's built in 'word' functions because
  422. # they don't allow for european characters....
  423.  
  424. proc IspellTextWindowInsert { text } { 
  425. #################
  426. # WARNING
  427. # CHANGES FOR SUPPORT OF EUROPEAN CHARACTERS!!
  428. ##########################
  429.     set start [ $text get "insert linestart" insert ]
  430.     
  431.     set s1 ""
  432.     
  433.     # now let's pick off the last word
  434.     regexp "\[^\t ]+$" $start s1
  435.  
  436.  
  437.     set startIndex "insert - [string length $s1] chars"
  438.     set stopIndex "insert" 
  439.  
  440.     set word " [ string trim $s1 "\"\{\}\[\]  \t" ] "
  441.  
  442.     IspellMarkWord $text $startIndex $stopIndex $word 
  443.  
  444. }
  445.  
  446. ####################################################
  447. # proc to mark words in the text window, with the given 
  448. # indexes, the 'word' is the word in question
  449. ####################################################
  450. proc IspellMarkWord {text startIndex stopIndex word} {
  451.  
  452.     global ispellVars ;
  453.  
  454.     #first let's not mark the word bad if we aren't in a section marked 'type=text*"
  455.  
  456.     if {$ispellVars(textOnly)} {
  457.     if { ! [ string match "*type=text*" [ $text tag names insert ] ] } { return * } ;
  458.     }
  459.  
  460.     set result [ IspellWords $word ];
  461.     #    * means fine, + means a root?, - means compount controlled by -C  option of ispell
  462.     if { ! [regexp {^[*+-]} $result ] } {
  463.     $text tag add MissSpelled $startIndex $stopIndex
  464.     set prompt "Suggested for $word: [ lreplace [ lindex $result 0 ] 0 3 ]"
  465.     # EXMH Specific 
  466.     SeditMsg $text $prompt
  467.     
  468.     } else {
  469.     $text tag remove MissSpelled $startIndex "$stopIndex +1c"
  470.     }
  471.     
  472.     set ispellVars(last_word) $word ; # store word so we don't re-check next
  473.     # time
  474.     return $result
  475. }
  476.  
  477.  
  478. ##############################################################
  479. # Proedure to call to mark words after the dictionary has been
  480. # modified, called from within the 'add' menus.....
  481. # 
  482. ##############################################################
  483.  
  484. proc IspellReCheckBuffer { window startIndex stopIndex word } { 
  485.     global ispellVars;
  486.     
  487.     # first let's make sure it's a real word....
  488.     if { $word == "" } return ;
  489.  
  490.     IspellMarkWord $window $startIndex $stopIndex $word; 
  491.  
  492.     # check word requested
  493.     if { [ info exists ispellVars(ReCheckAfterAdd) ] }  {
  494.     
  495.     if { $ispellVars(ReCheckAfterAdd) } { 
  496.         IspellReCheckWords $window ; 
  497.         # re-check buffer if requested..
  498.     }   
  499.     }
  500. }
  501.  
  502. ##########################################################
  503. # This proc will take the word currently under the mouse pointer
  504. # spell check it, and pop up a menu with suggestions or allowing
  505. # additions to the ispell-dictionary
  506. # 'text' is the text window, x,y are the co-ordinates relative to the
  507. # window, X,Y are the co-ordinates relative to the root window
  508. ##########################################################
  509.  
  510. proc IspellPostMenuChoices { text x y   X Y } { 
  511.  
  512.     global ispellVars;
  513.  
  514.     set adjustment {} 
  515.     set oldInsert [ $text index insert ] 
  516.     $text mark set insert "@$x,$y"
  517.  
  518.     set start [ $text get "insert linestart" insert ]
  519.     
  520.     set end   [ $text get insert "insert lineend" ] 
  521.     
  522.     set e1 ""
  523.     set s1 ""
  524.     
  525.     regexp "\[^\t \]*" $end e1
  526.     set e1 [ string trim $e1 ] 
  527.     regexp "\[^\t \]+$" $start s1
  528.  
  529.     set startIndex "insert - [string length $s1] chars"
  530.     set stopIndex "insert + [string length $e1] chars "
  531.     set word $s1$e1
  532.  
  533.     set word [ string trim $word  "\]\[\.\,\<\>\/\?\!\@\#\%\*0123456789\&\@\(\)\:\;\$ \{\}\"\\ \'\~\`\_\-\+\t\n\r\b\a\f\v\n "]   
  534.     set word [ string trim $word ]
  535.  
  536. #    set stopIndex [ $text index "@$x,$y wordend"  ]
  537. #    set startIndex [ $text index "$stopIndex  - 1 chars wordstart" ]
  538. #    set word  " [ string trim [ $text get $startIndex "$stopIndex wordend" ] \
  539. #        "\@\(\)\:\;\$ \{\}\"\\ \t\n\r\b\a\f\v\n "] " ; # "
  540. #    set word [ string trim $word ] ; # get rid of white space
  541.  
  542.     # if there is no word to mention, don't even post a menu...
  543.  
  544.     if { $word == "" } return ; 
  545.  
  546.     set result [ IspellMarkWord $text $startIndex $stopIndex $word ]
  547.  
  548.     $text mark set insert $oldInsert ; # get it back where it belongs
  549.     # create a meanu
  550.     set menu "$text.m"
  551.     catch { 
  552.     destroy $menu
  553.     }
  554.     menu $menu -tearoff f
  555.  
  556.     # remember the menu name so we can unpost it later.
  557.     set ispellVars(PopupMenu) $menu
  558.     
  559.     # first let's label the menu with the current language
  560.     $menu add command -label $ispellVars(language) -state disabled
  561.  
  562.     # now if spell checking is disabled, let's mark menus as such
  563.     set disFlag normal
  564.     if { $ispellVars(currentLanguage) == "disabled" } {
  565.     set disFlag "disabled" 
  566.     }
  567.  
  568.     $menu add separator 
  569.  
  570.     $menu add command -label "Add '$word' to Dictionary" -command  \
  571.         "IspellWriteSpellBuffer \"*$word\";\
  572.         IspellWriteSpellBuffer \#;\
  573.         IspellReCheckBuffer $text \"$startIndex\" \"$stopIndex\" $word;" -state $disFlag
  574.     # add word to dictionary, save dictionary, recheck word
  575.     
  576.     $menu add command -label "Accept '$word' for this session" -command \
  577.         "IspellWriteSpellBuffer \"@$word\";\
  578.         IspellReCheckBuffer $text \"$startIndex\"  \"$stopIndex\" $word;" -state $disFlag
  579.     # add word for this session, recheck word
  580.  
  581.     $menu add separator
  582.     foreach i   [ split [ lreplace [ lindex $result 0 ] 0 3 ] "," ]   {
  583.     set choice [ string trim $i ", " ]
  584.     $menu add command -label $choice -command "IspellReplaceWordInText $text $x $y \"$choice\" " 
  585.     }
  586.     $menu add separator
  587.  
  588.     menu $menu.sub -tearoff f
  589.  
  590.     $menu.sub add radiobutton -label "disabled" \
  591.         -command "set ispellVars(language) disabled ;
  592.     set ispellVars(command) \"\";
  593.     Ispell_Init" -variable ispellVars(language) -value "disabled"
  594.  
  595.  
  596.     $menu.sub add radiobutton -label "default" \
  597.     -command "set ispellVars(language) default ;
  598.         set ispellVars(command) \"$ispellVars(defaultCommand)\";
  599.         Ispell_Init" \
  600.     -variable ispellVars(language) -value "default"
  601.  
  602.     set count [ llength $ispellVars(otherCommands) ] 
  603.     for { set i 0 } { $i < $count } { incr i 2 } {
  604.     set lab  [ lindex $ispellVars(otherCommands) $i ]
  605.     set command  [ lindex $ispellVars(otherCommands) [ expr $i +1 ]  ]
  606.     $menu.sub add radiobutton -label "$lab " \
  607.         -command  " set ispellVars(language)  \"$lab\" ; 
  608.             set ispellVars(command) \"$command\"; 
  609.             Ispell_Init"  \
  610.         -variable ispellVars(language) -value "$lab"                       
  611.     }
  612.     
  613.     $menu add cascade -label "Alternate..." -menu $menu.sub
  614.  
  615.     tk_popup $menu $X $Y 
  616. }
  617.  
  618. #######################################################
  619. #
  620. # Procedure called to Unpost 
  621. # the menu
  622. #######################################################
  623. proc IspellUnPostMenuChoices {window } { 
  624.     global ispellVars
  625.  
  626.     catch {
  627.     tkMenuUnpost $ispellVars(PopupMenu)
  628.     }
  629. }
  630.  
  631. #########################################################
  632. # This proc will replace whatever word is listed at x,y
  633. # with 'word'  It goes to some lengths to keep surrouning
  634. # punctuation.
  635. #########################################################
  636. proc IspellReplaceWordInText { text x y word } { 
  637.  
  638.     set oldInsert [ $text index insert ] 
  639.  
  640.     $text mark set insert "@$x,$y"
  641.     
  642.     set start [ $text get "insert linestart" insert ]
  643.     
  644.     set end   [ $text get insert "insert lineend" ] 
  645.     
  646.     set e1 ""
  647.     set s1 ""
  648.     
  649.     regexp "\[^\t \]*" $end e1
  650.     set e1 [ string trim $e1 ] 
  651.     regexp "\[^\t \]+$" $start s1
  652.  
  653.     # If we are being asked to replace a word, first remove the tag
  654.     # so that whatever highlighting is there will be gone.
  655.     $text tag remove MissSpelled "insert - [string length $s1] chars" "insert + [string length $e1] chars "
  656.  
  657.     # Now let's clean up that string a bit..... remove punctuation & stuff
  658.  
  659.     set e1 [ string trim [ string trim $e1 ] "\]\[\.\,\<\>\/\?\!\@\#\%\*0123456789\&\@\(\)\:\;\$ \{\}\"\\ \'\~\`\_\-\+\t\n\r\b\a\f\v\n "]   
  660.  
  661.     set s1 [ string trim [ string trim $s1 ] "\]\[\.\,\<\>\/\?\!\@\#\%\*0123456789\&\@\(\)\:\;\$ \{\}\"\\ \'\~\`\_\-\+\t\n\r\b\a\f\v\n "]   
  662.  
  663.  
  664.     # now let's remove the old word & insert the new word.
  665.  
  666.     set startIndex "insert - [string length $s1] chars"
  667.     set stopIndex "insert + [string length $e1] chars "
  668.     set startInsert [ $text index $startIndex ] 
  669.  
  670.     $text delete $startIndex $stopIndex 
  671.     $text insert $startInsert $word
  672.     $text mark set insert $oldInsert ; # get it back where it belongs
  673. }
  674.  
  675. ##########################################################
  676. # EXMH Specific procedure to bind the window in question 
  677. # note that this has to be in the current process
  678. # it won't automagically be sucked in
  679. # a call to 'IspellPreferences' should do the trick...
  680. ##########################################################
  681. proc Hook_SeditInit_TagMissSpelled { file window } {
  682.     global ispellVars
  683.     # only configure the window for ispell support if it is
  684.     # actually needed, and if the appropriate variables exist
  685.     # 
  686.     # bind the window.....
  687.     # use default style of underline
  688.     set style "-underline t"
  689.  
  690.     if { [ catch {    
  691.     switch -exact -- $ispellVars(viewStyle) \
  692.         underline  { set style "-underline t"} \
  693.         italic     { set style "-font *italic*" } \
  694.         bold       { set style "-font *bold*"}  \
  695.         other      { set style "$ispellVars(viewStyle-Other)" } \
  696.         bgcolor    { set style "-background $ispellVars(viewStyle-Color)" } \
  697.         fgcolor    { set style "-foreground $ispellVars(viewStyle-Color)" } \ 
  698.     
  699.     
  700.     eval  $window tag configure MissSpelled $style
  701.     } result ] } {     
  702.     tk_dialog .window "Bad Style" \
  703.         "Invalid I-Spell style: '$result' changing to underline" \
  704.         {} 0 ok
  705.     eval $window tag configure MissSpelled -underline t
  706.     }
  707.     
  708.     # Only bind the window if 'ispell' is turned on...
  709.     if { [ info exists ispellVars(on) ] } {
  710.     if { $ispellVars(on) == 1 } { 
  711.         set ispellVars($window,effect) 1
  712.         Ispellbind $window 
  713.  
  714.     }
  715.     }
  716.  
  717.     set ispellVars(command) $ispellVars(defaultCommand)
  718.  
  719.     set ispellVars(language) "default" 
  720.  
  721.     # Only init the spell checker if it had already not been previously init'd
  722.     if { ! [ info exists ispellVars(spell_buffer) ] } { 
  723.     Ispell_Init ; # init if the spell buffer is undefine
  724.     }
  725. } 
  726.  
  727. # this procedure re-checks the entire buffer in the
  728. # window specified by 'window'
  729. proc Ispell_CheckEntireWindow { text } { 
  730.     global ispellVars
  731.  
  732.  
  733.     set oldInsert [ $text index insert ] 
  734.  
  735.     set count 0
  736.     # First things first, because this function COULD be called without
  737.     # using any of the other ispell stuff, first ensure that the ispell 
  738.     # process is running...
  739.     # Only init the spell checker if it had already not been previously init'd
  740.  
  741.     if { ! [ info exists ispellVars(spell_buffer) ] } { 
  742.     Ispell_Init ; # init if the spell buffer is undefine
  743.     }
  744.  
  745.     # Pop up a little window to allow spell checking to be turned off......
  746.     #
  747.     set ispellVars(label) "Stop Spell Checking"
  748.     catch { destroy .ispellStopWindow }
  749.     set top [ toplevel .ispellStopWindow ] 
  750.     wm group .ispellStopWindow .
  751.     button $top.b  -textvariable ispellVars(label) -command { 
  752.     set ispellVars(label) "" 
  753.     }
  754.     label $top.l1 -bitmap warning
  755.     label $top.l2 -bitmap warning
  756.     
  757.     pack $top.l1 -side left
  758.     pack $top.b -side left
  759.     pack $top.l2 -side left
  760.     
  761.     set endOfDoc [ $text index end ] ; # get the last index mark
  762.     set current 1.0
  763.  
  764.     # here is the actual code to spell check the document
  765.     while { [ expr $current < $endOfDoc ] }  {
  766.  
  767.     if { $ispellVars(label) == "" } { break}
  768.     $text mark set insert "$current"
  769.     set start [ $text get "insert linestart" insert ]
  770.     
  771.     set end   [ $text get insert "insert lineend" ] 
  772.     set e1 ""
  773.     set s1 ""
  774.     
  775.     regexp "\[^\t \]*" $end e1
  776. #    set e1 [ string trim $e1 ] 
  777.     regexp "\[^\t \]+$" $start s1
  778.     
  779.     set startIndex "insert - [string length $s1] chars"
  780.     set stopIndex "insert + [string length $e1] chars "
  781.     
  782.     set word "[ string trim $s1$e1 "\"\{\}\[\]" ] "
  783.     
  784.     set current [ $text index "$stopIndex + 2 chars" ]
  785.  
  786.     if {[string length $word] == 1} continue; # speed up process for small words....
  787.  
  788.     incr count
  789.     update
  790.  
  791.     if { $count > 120 } {
  792.         
  793.         $text see $current
  794.         set count 0
  795.     }
  796.  
  797.     IspellMarkWord $text $startIndex $stopIndex $word 
  798.     }
  799.     
  800.     destroy $top
  801.     # now let's redisplay the screen at the insert point....
  802.     $text mark set insert "$oldInsert"
  803.     $text see insert
  804. }
  805.  
  806.  
  807. ########################################################
  808. # procedure to re-check bound words to reconfirm they
  809. # are still missspelled
  810. # note that if quite a few words are missSpelled this could
  811. # take quite a while.... Also note that this should probably
  812. # only be called AFTER the dictionary has changed/updated
  813. ########################################################
  814.  
  815. proc IspellReCheckWords {window} { 
  816.     global ispellVars
  817.     
  818.  
  819.     set ranges [ $window tag ranges MissSpelled ] 
  820.     set ispellVars(label) "Stop Spell Checking"
  821.     set wcount 0
  822.  
  823.     if { [ expr [ llength $ranges ] > 100 ] } { 
  824.     # Only pop up a window if
  825.     # 100 or so need to be re-checked.
  826.     catch {
  827.         destroy .ispellStop
  828.     }
  829.  
  830.     toplevel .ispellStop
  831.     button .ispellStop.b  -textvariable ispellVars(label) -command { 
  832.         set ispellVars(label) "" 
  833.     }
  834.     label .ispellStop.l1 -bitmap warning
  835.     label .ispellStop.l2 -bitmap warning
  836.     
  837.     pack .ispellStop.l1 -side left
  838.     pack .ispellStop.b -side left
  839.     pack .ispellStop.l2 -side left
  840.     }
  841.  
  842.     # loop through all the current words marked as misspelled
  843.     #
  844.     for { set i 0 } { $i < [ expr [llength $ranges] / 2 ] } { incr i } {
  845.     set startIndex [ lindex $ranges [ expr $i*2 ] ] 
  846.     set stopIndex  [ lindex $ranges [ expr $i*2+1 ] ]
  847.     
  848.     if { [ $window compare "$startIndex + 1 chars" == "$stopIndex" ] } {
  849.         $window tag remove MissSpelled $startIndex "$stopIndex +1c"
  850.     }
  851.     set word  " [ string trim [ $window get $startIndex $stopIndex ] \
  852.          " \t\"\{\}\[\]"] " ; # "
  853.     if { $ispellVars(label) == "" } { break }
  854.  
  855.     incr wcount
  856.     if { $wcount > 20 } {
  857.         $window see $startIndex
  858.         set wcount 0
  859.     }
  860.  
  861.     update
  862.     set result [ IspellMarkWord $window $startIndex $stopIndex $word ]
  863.  
  864.     }
  865.  
  866.     # destroy the toplevel window
  867.  
  868.     catch {
  869.     destroy .ispellStop
  870.     }
  871.  
  872.     # put the window back under the insert cursor
  873.  
  874.     $window see insert
  875. }
  876.  
  877.  
  878. # Call this procedure with the text window path to bind the spell command
  879.  
  880. proc Ispellbind { text } { 
  881.  
  882.     global ispellVars;
  883.  
  884.     set command {IspellTextWindow %W} ; 
  885.     
  886.  
  887.     bind $text <Key-space> "IspellTextWindowInsert %W"
  888.     bind $text <Key-Tab> "IspellTextWindowInsert %W" 
  889.     
  890.     bind $text <Key-Right> "$command"   
  891.     bind $text <Key-Left>  "$command"    
  892.     bind $text <Key-Down>  "$command"
  893.     bind $text <Key-Up>    "$command"
  894.     
  895.     bind $text <Key-Return> " $command "
  896.     
  897.     # How do we correct words? Normally button-3!
  898.     bind $text <$ispellVars(popupBinding)> { 
  899.     IspellPostMenuChoices %W %x %y %X %Y 
  900.     } ;
  901.  
  902.     # no user configurable way to select the unpost...
  903.     # tk_popup should unpost the menu for us automatically
  904. #    bind $text <Any-ButtonRelease> { IspellUnPostMenuChoices %W } 
  905.     
  906. }
  907.  
  908.  
  909.     
  910.     
  911.  
  912.  
  913.  
  914.  
  915.  
  916.  
  917.  
  918.